{
  $Project$
  $Workfile$
  $Revision$
  $DateUTC$
  $Id$

  This file is part of the Indy (Internet Direct) project, and is offered
  under the dual-licensing agreement described on the Indy website.
  (http://www.indyproject.org/)

  Copyright:
   (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved.
}
{
  $Log$
}
{
{   Rev 1.38    11/15/2004 11:59:12 PM  JPMugaas
{ Hopefully, this should handle IPv6 addresses in SOCKS bind and listen.
}
{
{   Rev 1.37    11/12/2004 11:30:18 AM  JPMugaas
{ Expansions for IPv6.
}
{
{   Rev 1.36    11/11/2004 10:25:24 PM  JPMugaas
{ Added OpenProxy and CloseProxy so you can do RecvFrom and SendTo functions
{ from the UDP client with SOCKS.  You must call OpenProxy  before using
{ RecvFrom or SendTo.  When you are finished, you must use CloseProxy to close
{ any connection to the Proxy.  Connect and disconnect also call OpenProxy and
{ CloseProxy.
}
{
{   Rev 1.35    11/11/2004 3:42:50 AM  JPMugaas
{ Moved strings into RS.  Socks will now raise an exception if you attempt to
{ use SOCKS4 and SOCKS4A with UDP.  Those protocol versions do not support UDP
{ at all.
}
{
{   Rev 1.34    11/10/2004 10:55:58 PM  JPMugaas
{ UDP Association bug fix - we now send 0's for IP address and port.
}
{
{   Rev 1.33    11/10/2004 10:38:42 PM  JPMugaas
{ Bug fixes - UDP with SOCKS now works.
}
{
{   Rev 1.32    11/10/2004 9:42:54 PM  JPMugaas
{ 1 in a reserved position should be 0 in a UDP request packet.
}
{
{   Rev 1.31    11/9/2004 8:18:00 PM  JPMugaas
{ Attempt to add SOCKS support in UDP.
}
{
{   Rev 1.30    03/07/2004 10:08:22  CCostelloe
{ Removed spurious code that generates warning
}
{
{   Rev 1.29    6/9/04 7:44:44 PM  RLebeau
{ various ReadBytes() tweaks
{ 
{ updated MakeSocks4Request() to call AIOHandler.WriteBufferCancel() on error.
}
{
{   Rev 1.28    2004.05.20 1:39:58 PM  czhower
{ Last of the IdStream updates
}
{
{   Rev 1.27    2004.05.20 9:19:24 AM  czhower
{ Removed unused var
}
{
    Rev 1.26    5/19/2004 10:44:42 PM  DSiders
  Corrected spelling for TIdIPAddress.MakeAddressObject method.
}
{
{   Rev 1.25    5/19/2004 2:44:40 PM  JPMugaas
{ Fixed compiler warnings in TIdSocksInfo.Listen.
}
{
{   Rev 1.24    5/8/2004 3:45:34 PM  BGooijen
{ Listen works in Socks 4 now
}
{
{   Rev 1.23    5/7/2004 4:52:44 PM  JPMugaas
{ Bind in SOCKS4 should work a bit better.  There's still some other work that
{ needs to be done on it.
}
{
{   Rev 1.22    5/7/2004 8:54:54 AM  JPMugaas
{ Attempt to add SOCKS4 bind.
}
{
{   Rev 1.21    5/7/2004 7:43:24 AM  JPMugaas
{ Checked Bas's changes.
}
{
{   Rev 1.20    5/7/2004 5:53:20 AM  JPMugaas
{ Removed some duplicate code to reduce the probability of error.
}
{
{   Rev 1.19    5/7/2004 1:44:12 AM  BGooijen
{ Bind
}
{
{   Rev 1.18    5/6/2004 6:47:04 PM  JPMugaas
{ Attempt to work on bind further.
}
{
{   Rev 1.16    5/6/2004 5:32:58 PM  JPMugaas
{ Port was being mangled because the compiler was assuming you wanted a 4 byte
{ byte order instead of only a two byte byte order function.
{ IP addresses are better handled.  At least I can connect again.
}
{
{   Rev 1.15    5/5/2004 2:09:40 PM  JPMugaas
{ Attempt to reintroduce bind and listen functionality for FTP.
}
{
{   Rev 1.14    2004.03.07 11:48:44 AM  czhower
{ Flushbuffer fix + other minor ones found
}
{
{   Rev 1.13    2004.02.03 4:16:52 PM  czhower
{ For unit name changes.
}
{
{   Rev 1.12    2/2/2004 2:33:04 PM  JPMugaas
{ Should compile better.
}
{
{   Rev 1.11    2/2/2004 12:23:16 PM  JPMugaas
{ Attempt to fix the last Todo concerning IPv6.
}
{
{   Rev 1.10    2/2/2004 11:43:08 AM  BGooijen
{ DotNet
}
{
{   Rev 1.9    2/2/2004 12:00:08 AM  BGooijen
{ Socks 4 / 4A working again
}
{
{   Rev 1.8    2004.01.20 10:03:34 PM  czhower
{ InitComponent
}
{
{   Rev 1.7    1/11/2004 10:45:56 PM  BGooijen
{ Socks 5 works on D7 now, Socks 4 almost
}
{
{   Rev 1.6    2003.10.11 5:50:34 PM  czhower
{ -VCL fixes for servers
{ -Chain suport for servers (Super core)
{ -Scheduler upgrades
{ -Full yarn support
}
{
{   Rev 1.5    2003.10.01 1:37:34 AM  czhower
{ .Net
}
{
{   Rev 1.4    2003.09.30 7:37:28 PM  czhower
{ Updates for .net
}
{
    Rev 1.3    4/2/2003 3:23:00 PM  BGooijen
  fixed and re-enabled
}
{
{   Rev 1.2    2003.01.10 8:21:04 PM  czhower
{ Removed more warnings
}
{
{   Rev 1.1    2003.01.10 7:21:14 PM  czhower
{ Removed warnings
}
{
{   Rev 1.0    11/13/2002 08:58:56 AM  JPMugaas
}
unit IdSocks;

interface

uses
  IdAssignedNumbers, IdException, IdBaseComponent,
  IdComponent, IdCustomTransparentProxy, IdGlobal, IdIOHandler,
  IdIOHandlerSocket, IdSocketHandle, IdSys, IdObjs;

type
  EIdSocksUDPNotSupportedBySOCKSVersion = class(EIdException);
  TSocksVersion = (svNoSocks, svSocks4, svSocks4A, svSocks5);
  TSocksAuthentication = (saNoAuthentication, saUsernamePassword);

const
  ID_SOCKS_AUTH = saNoAuthentication;
  ID_SOCKS_VER = svNoSocks;

type
  TIdSocksInfo = class(TIdCustomTransparentProxy)
  protected
    FAuthentication: TSocksAuthentication;
    FVersion: TSocksVersion;
    FUDPSocksAssociation : TIdIOHandlerSocket;
   
    //
    function DisasmUDPReplyPacket(const APacket : TIdBytes;
      var VHost : String; var VPort : Integer): TIdBytes;
    function MakeUDPRequestPacket(const AData: TIdBytes;
      const AHost : String; const APort : Integer) : TIdBytes;
    procedure AssignTo(ASource: TIdPersistent); override;
    function GetEnabled: Boolean; override;
    procedure InitComponent; override;
    procedure AuthenticateSocks5Connection(AIOHandler: TIdIOHandler);
    // This must be defined with an port value that's a word so that we use the 2 byte Network Order byte functions instead
    // the 4 byte or 8 byte functions.  If we use the wrong byte order functions, we can get a zero port value causing an error.
    procedure MakeSocks4Request(AIOHandler: TIdIOHandler; const AHost: string; const APort: Word; const ARequest : Byte);
    procedure MakeSocks5Request(AIOHandler: TIdIOHandler; const AHost: string; const APort: Word; const ARequest : Byte; var VBuf : TIdBytes; var VLen : Integer);
    procedure MakeSocks4Connection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
    procedure MakeSocks4Bind(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
    procedure MakeSocks5Connection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
    procedure MakeSocks5Bind(AIOHandler: TIdIOHandler; const AHost: string;
      const APort: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
    procedure MakeConnection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
    function  MakeSocks4Listen(AIOHandler: TIdIOHandler; const ATimeOut:integer):boolean;
    function  MakeSocks5Listen(AIOHandler: TIdIOHandler; const ATimeOut:integer):boolean;

    //association for UDP
    procedure MakeSocks5UDPAssociation(AHandle : TIdSocketHandle);
    procedure CloseSocks5UDPAssociation;
  public
    destructor Destroy; override;
    procedure Bind(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
    function  Listen(AIOHandler: TIdIOHandler; const ATimeOut:integer):boolean;override;
    procedure OpenUDP(AHandle : TIdSocketHandle; const AHost: string=''; const APort: Integer=0; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); override;
    function RecvFromUDP(AHandle: TIdSocketHandle;
      var ABuffer : TIdBytes;
      var VPeerIP: string; var VPeerPort: integer; const AIPVersion: TIdIPVersion;
       AMSec: Integer = IdTimeoutDefault): integer; override;
    procedure SendToUDP(AHandle: TIdSocketHandle;
      AHost: string; const APort: Integer; const AIPVersion: TIdIPVersion; const ABuffer : TIdBytes); override;
    procedure CloseUDP(AHandle: TIdSocketHandle); override;
  published
    property Authentication: TSocksAuthentication read FAuthentication write FAuthentication default ID_SOCKS_AUTH;
    property Host;
    property Password;
    property Port default IdPORT_SOCKS;
    property IPVersion;
    property Username;
    property Version: TSocksVersion read FVersion write FVersion default ID_SOCKS_VER;
    property  ChainedProxy;
  End;//TIdSocksInfo

implementation

uses
   IdResourceStringsCore, IdExceptionCore, IdIPAddress, IdStack,
  IdTCPClient,
  IdIOHandlerStack;

{ TIdSocksInfo }

procedure TIdSocksInfo.AssignTo(ASource: TIdPersistent);
begin
  if ASource is TIdSocksInfo then begin
    inherited AssignTo(ASource);
    with TIdSocksInfo(ASource) do begin
      Authentication := Self.Authentication;
      Version := Self.Version;
    end;
  end else begin
    inherited AssignTo(ASource);
  end;
end;

procedure TIdSocksInfo.MakeSocks4Request(AIOHandler: TIdIOHandler; const AHost: string; const APort: Word; const ARequest : Byte);
var
  LIpAddr: String;
  LTempPort : Word;
begin
  AIOHandler.WriteBufferOpen;
  try
    AIOHandler.Write(ToBytes(Byte(4))); // Version
    AIOHandler.Write(ToBytes(ARequest)); // Opcode

    LTempPort := GStack.HostToNetwork(APort);
    AIOHandler.Write(ToBytes(LTempPort)); // Port

    if Version = svSocks4A then begin
      LIpAddr := '0.0.0.1';    {Do not Localize}
    end else begin
      LIpAddr := GStack.ResolveHost(AHost,Id_IPv4);
    end;

    AIOHandler.Write(ToBytes(Byte(Sys.StrToInt(Fetch(LIpAddr,'.')))));// IP
    AIOHandler.Write(ToBytes(Byte(Sys.StrToInt(Fetch(LIpAddr,'.')))));// IP
    AIOHandler.Write(ToBytes(Byte(Sys.StrToInt(Fetch(LIpAddr,'.')))));// IP
    AIOHandler.Write(ToBytes(Byte(Sys.StrToInt(Fetch(LIpAddr,'.')))));// IP

    AIOHandler.Write(ToBytes(Username));
    AIOHandler.Write(ToBytes(Byte(0)));// Username

    if Version = svSocks4A then begin
      AIOHandler.Write(ToBytes(AHost));
      AIOHandler.Write(ToBytes(Byte(0)));// Host
    end;

    AIOHandler.WriteBufferClose; //flush everything
  except
    AIOHandler.WriteBufferCancel; //cancel everything
    raise;
  end;
end;

procedure TIdSocksInfo.MakeSocks4Connection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
var
  LResponse: TIdBytes;
begin
  MakeSocks4Request(AIOHandler, AHost, APort,$01); //connect
  AIOHandler.ReadBytes(LResponse, 8, False);
  case LResponse[1] of // OpCode
    90: ;// request granted, do nothing
    91: raise EIdSocksRequestFailed.Create(RSSocksRequestFailed);
    92: raise EIdSocksRequestServerFailed.Create(RSSocksRequestServerFailed);
    93: raise EIdSocksRequestIdentFailed.Create(RSSocksRequestIdentFailed);
    else raise EIdSocksUnknownError.Create(RSSocksUnknownError);
  end;
end;

procedure TIdSocksInfo.MakeSocks5Request(AIOHandler: TIdIOHandler; const AHost: string; const APort: Word; const ARequest : Byte; var VBuf : TIdBytes; var VLen : Integer);
var LtempPort : Word;
  LIP : TIdIPAddress;
begin
  // Connection process
  VBuf[0] := $5;   // socks version
  VBuf[1] := ARequest; //request method
  VBuf[2] := $0;   // reserved

  if (length(MakeCanonicalIPv6Address(AHost))>0) then begin
    VBuf[3] := $4;   // address type: IP V4 address: X'01'    {Do not Localize}
                           //               DOMAINNAME:    X'03'    {Do not Localize}
                           //               IP V6 address: X'04'    {Do not Localize}

    VBuf[4] :=16; // 16 bytes for the ip
    VLen := 5;
    LIP := TIdIPAddress.MakeAddressObject(AHost);
    try
      if Assigned(LIP) then
      begin
        CopyTIdBytes(LIP.HToNBytes,0,VBuf,4,16);
      end;
    finally
      Sys.FreeAndNil(LIP);
    end;
    VLen := VLen + 16;
  end
  else
  begin
    // for now we stick with domain name, must ask Chad how to detect
    // address type
    if GStack.IsIP( AHost ) then
    begin
      VBuf[3] := $01;  //IPv4 address
      LIP := TIdIPAddress.MakeAddressObject(AHost);
      try
        if Assigned(LIP) then
        begin
          CopyTIdBytes(LIP.HToNBytes,0,VBuf,4,4);
        end;
      finally
        Sys.FreeAndNil(LIP);
      end;
      VLen := 8;
    end
    else
    begin
      VBuf[3] := $3;   // address type: IP V4 address: X'01'    {Do not Localize}
                           //               DOMAINNAME:    X'03'    {Do not Localize}
                           //               IP V6 address: X'04'    {Do not Localize}
      // host name
      VBuf[4] := Length(AHost);
      VLen := 5;
      if Length(AHost) > 0 then begin
        CopyTIdBytes(ToBytes(AHost),0,VBuf,VLen,Length(AHost));
      end;
      VLen := VLen + Length(AHost);
    end;

  end;

  // port

  LtempPort := GStack.HostToNetwork(APort);
  CopyTIdBytes(ToBytes(LtempPort),0,VBuf,VLen,2);
  VLen := VLen + 2;
end;

procedure TIdSocksInfo.MakeSocks5Connection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
var
  pos: Integer;
  LBuf: TIdBytes;

begin
  AuthenticateSocks5Connection(AIOHandler);
  SetLength(LBuf, 255);
  MakeSocks5Request(AIOHandler, AHost, APort, $01, LBuf, Pos);

  LBuf:=ToBytes(LBuf, Pos);
  AIOHandler.WriteDirect(LBuf); // send the connection packet
  try
    AIOHandler.ReadBytes(LBuf, 5, False);    // Socks server replies on connect, this is the first part
  except
    raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
  end;

  case LBuf[1] of
    0: ;// success, do nothing
    1: raise EIdSocksServerGeneralError.Create(RSSocksServerGeneralError);
    2: raise EIdSocksServerPermissionError.Create(RSSocksServerPermissionError);
    3: raise EIdSocksServerNetUnreachableError.Create(RSSocksServerNetUnreachableError);
    4: raise EIdSocksServerHostUnreachableError.Create(RSSocksServerHostUnreachableError);
    5: raise EIdSocksServerConnectionRefusedError.Create(RSSocksServerConnectionRefusedError);
    6: raise EIdSocksServerTTLExpiredError.Create(RSSocksServerTTLExpiredError);
    7: raise EIdSocksServerCommandError.Create(RSSocksServerCommandError);
    8: raise EIdSocksServerAddressError.Create(RSSocksServerAddressError);
    else
       raise EIdSocksUnknownError.Create(RSSocksUnknownError);
  end;

  // type of destination address is domain name
  case LBuf[3] of
    // IP V4
    1: pos := 4 + 2; // 4 is for address and 2 is for port length
    // FQDN
    3: pos := LBuf[4] + 2; // 2 is for port length
    // IP V6
    4: pos := 16 + 2; // 16 is for address and 2 is for port length
  end;

  try
    // Socks server replies on connect, this is the second part
    // RLebeau: why -1?
    AIOHandler.ReadBytes(LBuf, pos-1, False);      // just write it over the first part for now
  except
    raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
  end;
end;

procedure TIdSocksInfo.MakeSocks4Bind(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer);
var
  LResponse: TIdBytes;
  LClient: TIdTcpClient;
begin
  LClient := TIdTCPClient.Create(nil);
  try
//    SetLength(LResponse, 255);
    SetLength(LResponse, 8);
    TIdIOHandlerSocket(AIOHandler).TransparentProxy := nil;
    LClient.IOHandler := AIOHandler;
    LClient.Host := Host;
    LClient.Port := Port;
    LClient.Connect;
    TIdIOHandlerSocket(AIOHandler).TransparentProxy := Self;
    MakeSocks4Request(AIOHandler, AHost, APort, $02); //bind
    AIOHandler.ReadBytes(LResponse, 2, False);
    case LResponse[1] of // OpCode
      90: ;// request granted, do nothing
      91: raise EIdSocksRequestFailed.Create(RSSocksRequestFailed);
      92: raise EIdSocksRequestServerFailed.Create(RSSocksRequestServerFailed);
      93: raise EIdSocksRequestIdentFailed.Create(RSSocksRequestIdentFailed);
    else raise EIdSocksUnknownError.Create(RSSocksUnknownError);
    end;

    try
      // Socks server replies on connect, this is the second part
      AIOHandler.ReadBytes(LResponse, 6, False); //overwrite the first part for now
      TIdIOHandlerSocket(AIOHandler).Binding.SetBinding( Sys.IntToStr(LResponse[2])+'.'+Sys.IntToStr(LResponse[3])+'.'+Sys.IntToStr(LResponse[4])+'.'+Sys.IntToStr(LResponse[5]) , LResponse[0]*256+LResponse[1]);
    except
      raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
    end;
  finally
    LClient.IOHandler := nil;
    Sys.FreeAndNil(LClient);
  end;
end;

procedure TIdSocksInfo.MakeConnection(AIOHandler: TIdIOHandler; const AHost: string; const APort: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
begin
  case Version of
    svSocks4, svSocks4A: MakeSocks4Connection(AIOHandler, AHost, APort);
    svSocks5: MakeSocks5Connection(AIOHandler, AHost, APort);
  end;
end;

function TIdSocksInfo.GetEnabled: Boolean;
Begin
  Result := Version in [svSocks4, svSocks4A, svSocks5];
End;//

procedure TIdSocksInfo.InitComponent;
begin
  inherited InitComponent;
  Authentication := ID_SOCKS_AUTH;
  Version := ID_SOCKS_VER;
  Port := IdPORT_SOCKS;
  FIPVersion := ID_DEFAULT_IP_VERSION;
  FUDPSocksAssociation := TIdIOHandlerStack.Create;
end;

procedure TIdSocksInfo.AuthenticateSocks5Connection(
  AIOHandler: TIdIOHandler);
var
  pos: Integer;
  LBuf: TIdBytes;
  LRequestedAuthMethod,
  LServerAuthMethod,
  LUsernameLen,
  LPasswordLen : Byte;
begin
  SetLength(LBuf, 3);
  // defined in rfc 1928
  if Authentication = saNoAuthentication then begin
    LBuf[2] := $0   // No authentication
  end else begin
    LBuf[2] := $2;  // Username password authentication
  end;

  LRequestedAuthMethod := LBuf[2];
  LBuf[0] := $5;     // socks version
  LBuf[1] := $1;     // number of possible authentication methods
  AIOHandler.WriteDirect(LBuf);
  try
    AIOHandler.ReadBytes(LBuf, 2, False); // Socks server sends the selected authentication method
  except
    On E: Exception do begin
      raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
    end;
  end;

  LServerAuthMethod := LBuf[1];
  if (LServerAuthMethod <> LRequestedAuthMethod) or (LServerAuthMethod = $FF) then begin
    raise EIdSocksAuthMethodError.Create(RSSocksAuthMethodError);
  end;

  // Authentication process
  if Authentication = saUsernamePassword then begin
    LUsernameLen := Length(Username);
    LPasswordLen := Length(Password);
    SetLength(LBuf, 3 + LUsernameLen + LPasswordLen);
    LBuf[0] := 1; // version of subnegotiation
    LBuf[1] := LUsernameLen;
    pos := 2;
    if LUsernameLen > 0 then begin
      CopyTIdBytes(ToBytes(Username), 0, LBuf, pos, LUsernameLen);
      pos := pos + LUsernameLen;
    end;
    LBuf[pos] := LPasswordLen;
    pos := pos + 1;
    if LPasswordLen > 0 then begin
      CopyTIdBytes(ToBytes(Password), 0, LBuf, pos, LPasswordLen);
    end;

    AIOHandler.WriteDirect(LBuf); // send the username and password
    try
      AIOHandler.ReadBytes(LBuf, 2, False);    // Socks server sends the authentication status
    except
      On E: Exception do begin
        raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
      end;
    end;

    if LBuf[1] <> $0 then begin
      raise EIdSocksAuthError.Create(RSSocksAuthError);
    end;
  end;
end;

procedure TIdSocksInfo.MakeSocks5Bind(AIOHandler: TIdIOHandler; const AHost: string;
  const APort: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
var
  Lpos: Integer;
  LBuf: TIdBytes;
  LClient:TIdTcpClient;
   LType : Byte;
begin
  LClient := TIdTCPClient.Create(nil);
  try
    SetLength(LBuf, 255);
    TIdIOHandlerSocket(AIOHandler).TransparentProxy := nil;
    LClient.IOHandler := AIOHandler;
    LClient.Host := Host;
    LClient.IPVersion := IPVersion;
    LClient.Port := Port;
    LClient.Connect;
    TIdIOHandlerSocket(AIOHandler).TransparentProxy := Self;

    AuthenticateSocks5Connection(AIOHandler);
    // Bind process
    MakeSocks5Request(AIOHandler, AHost, APort, $02, LBuf, LPos); //bind request
    //
    AIOHandler.Write(ToBytes(LBuf, LPos)); // send the connection packet
    try
      AIOHandler.ReadBytes(LBuf, 4, False);    // Socks server replies on connect, this is the first part
    except
      raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
    end;

    case LBuf[1] of
      0: ;// success, do nothing
      1: raise EIdSocksServerGeneralError.Create(RSSocksServerGeneralError);
      2: raise EIdSocksServerPermissionError.Create(RSSocksServerPermissionError);
      3: raise EIdSocksServerNetUnreachableError.Create(RSSocksServerNetUnreachableError);
      4: raise EIdSocksServerHostUnreachableError.Create(RSSocksServerHostUnreachableError);
      5: raise EIdSocksServerConnectionRefusedError.Create(RSSocksServerConnectionRefusedError);
      6: raise EIdSocksServerTTLExpiredError.Create(RSSocksServerTTLExpiredError);
      7: raise EIdSocksServerCommandError.Create(RSSocksServerCommandError);
      8: raise EIdSocksServerAddressError.Create(RSSocksServerAddressError);
      else
        raise EIdSocksUnknownError.Create(RSSocksUnknownError);
    end;
    LType := LBuf[3];
    // type of destination address is domain name
    case LType of
      // IP V4
      1: Lpos := 4 + 2; // 4 is for address and 2 is for port length
      // FQDN
      3: Lpos := LBuf[4] + 2; // 2 is for port length
      // IP V6
      4: LPos := 16 + 2; // 16 is for address and 2 is for port length
    end;
    try
      // Socks server replies on connect, this is the second part
      AIOHandler.ReadBytes(LBuf, Lpos, False); //overwrite the first part for now
      case LType of
        1 : begin
              //IPv4
              TIdIOHandlerSocket(AIOHandler).binding.SetBinding( Sys.IntToStr(LBuf[0])+'.'+Sys.IntToStr(LBuf[1])+'.'+Sys.IntToStr(LBuf[2])+'.'+Sys.IntToStr(LBuf[3]) ,LBuf[4]*256+LBuf[5],Id_IPv4);
            end;
        3 : begin
              TIdIOHandlerSocket(AIOHandler).Binding.SetPeer(GStack.ResolveHost(BytesToString( LBuf,0,LPos-2 )),LBuf[4]*256+LBuf[5],TIdIOHandlerSocket(AIOHandler).IPVersion );
            end;
        4 : begin
              TIdIOHandlerSocket(AIOHandler).binding.SetBinding( IPv6AddressToStr(BytesToIPv6(LBuf)) ,LBuf[16]*256+LBuf[17],Id_IPv6);
            end;
      end;
    except
      raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
    end;
  finally
    LClient.IOHandler := nil;
    Sys.FreeAndNil(LClient);
  end;
end;

procedure TIdSocksInfo.Bind(AIOHandler: TIdIOHandler; const AHost: string;
  const APort: Integer; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
begin
  case Version of
    svSocks4, svSocks4A: MakeSocks4Bind(AIOHandler, AHost, APort);
    svSocks5: MakeSocks5Bind(AIOHandler, AHost, APort, AIPVersion);
  end;
end;

function TIdSocksInfo.Listen(AIOHandler: TIdIOHandler;
  const ATimeOut: integer): boolean;
begin
  Result := False;
  case Version of
    svSocks4, svSocks4A: Result := MakeSocks4Listen(AIOHandler, ATimeOut);
    svSocks5: Result := MakeSocks5Listen(AIOHandler, ATimeOut);
  end;
end;

function TIdSocksInfo.MakeSocks5Listen(AIOHandler: TIdIOHandler;
  const ATimeOut: integer): boolean;
var
  Lpos: Integer;
  LBuf: TIdBytes;
  LType : Byte;
begin
  SetLength(LBuf, 255);
  Result := TIdIOHandlerSocket(AIOHandler).Binding.Readable(ATimeOut);
  if Result then begin
    AIOHandler.ReadBytes(LBuf, 4, False);    // Socks server replies on connect, this is the first part

    case LBuf[1] of
      0: ;// success, do nothing
      1: raise EIdSocksServerGeneralError.Create(RSSocksServerGeneralError);
      2: raise EIdSocksServerPermissionError.Create(RSSocksServerPermissionError);
      3: raise EIdSocksServerNetUnreachableError.Create(RSSocksServerNetUnreachableError);
      4: raise EIdSocksServerHostUnreachableError.Create(RSSocksServerHostUnreachableError);
      5: raise EIdSocksServerConnectionRefusedError.Create(RSSocksServerConnectionRefusedError);
      6: raise EIdSocksServerTTLExpiredError.Create(RSSocksServerTTLExpiredError);
      7: raise EIdSocksServerCommandError.Create(RSSocksServerCommandError);
      8: raise EIdSocksServerAddressError.Create(RSSocksServerAddressError);
      else
        raise EIdSocksUnknownError.Create(RSSocksUnknownError);
    end;
    LType := LBuf[3];
    // type of destination address is domain name
    case LType of
      // IP V4
      1: Lpos := 4 + 2; // 4 is for address and 2 is for port length
      // FQDN
      3: Lpos := LBuf[4] + 2; // 2 is for port length
      // IP V6  - 4:
    else
      Lpos := 16 + 2; // 16 is for address and 2 is for port length
    end;
    // Socks server replies on connect, this is the second part
    AIOHandler.ReadBytes(LBuf, Lpos, False);      // just write it over the first part for now
    case LType of
    //IPv4
      1 : TIdIOHandlerSocket(AIOHandler).Binding.SetPeer(Sys.IntToStr(LBuf[0])+'.'+Sys.IntToStr(LBuf[1])+'.'+Sys.IntToStr(LBuf[2])+'.'+Sys.IntToStr(LBuf[3]),LBuf[4]*256+LBuf[5],Id_IPv4);
    //FQN
      3 : TIdIOHandlerSocket(AIOHandler).Binding.SetPeer(GStack.ResolveHost(BytesToString( LBuf,0,LPos-2 )),LBuf[4]*256+LBuf[5],TIdIOHandlerSocket(AIOHandler).IPVersion );
    else
    //IPv6
      TIdIOHandlerSocket(AIOHandler).binding.SetBinding( IPv6AddressToStr(BytesToIPv6(LBuf)) ,LBuf[16]*256+LBuf[17],Id_IPv6);
    end;
  end;
end;

function TIdSocksInfo.MakeSocks4Listen(AIOHandler: TIdIOHandler;
  const ATimeOut: integer): boolean;
var
  LBuf: TIdBytes;
begin
  SetLength(LBuf, 6);
  Result := TIdIOHandlerSocket(AIOHandler).Binding.Readable(ATimeOut);
  if Result then begin
    AIOHandler.ReadBytes(LBuf, 2, False);    // Socks server replies on connect, this is the first part

    case LBuf[1] of // OpCode
      90: ;// request granted, do nothing
      91: raise EIdSocksRequestFailed.Create(RSSocksRequestFailed);
      92: raise EIdSocksRequestServerFailed.Create(RSSocksRequestServerFailed);
      93: raise EIdSocksRequestIdentFailed.Create(RSSocksRequestIdentFailed);
    else raise EIdSocksUnknownError.Create(RSSocksUnknownError);
    end;

    // Socks server replies on connect, this is the second part
    AIOHandler.ReadBytes(LBuf, 6, False);      // just write it over the first part for now
    TIdIOHandlerSocket(AIOHandler).Binding.SetPeer(Sys.IntToStr(LBuf[2])+'.'+Sys.IntToStr(LBuf[3])+'.'+Sys.IntToStr(LBuf[4])+'.'+Sys.IntToStr(LBuf[5]) , LBuf[0]*256+LBuf[1]);
  end;
end;

procedure TIdSocksInfo.CloseSocks5UDPAssociation;
begin
  if Assigned(FUDPSocksAssociation) then
  begin
    FUDPSocksAssociation.Close;
  end;
end;

procedure TIdSocksInfo.MakeSocks5UDPAssociation(AHandle: TIdSocketHandle);
var
  Lpos: Integer;
  LBuf: TIdBytes;
  LIPVersion : TIdIPVersion;
begin
  FUDPSocksAssociation.Host := Self.Host;
  FUDPSocksAssociation.Port := Self.Port;
  FUDPSocksAssociation.IPVersion := Self.IPVersion;
  LIPVersion := Self.IPVersion;
  FUDPSocksAssociation.Open;
  try
    SetLength(LBuf, 255);
    AuthenticateSocks5Connection(FUDPSocksAssociation);
    // Associate process
    //For SOCKS5 Associate, the IP address and port is the client's IP address and port which may
    //not be known
    if IPVersion = IdGlobal.Id_IPv4 then
    begin
      MakeSocks5Request(FUDPSocksAssociation, '0.0.0.0', 0, $03, LBuf, LPos); //associate request
    end
    else
    begin
      MakeSocks5Request(FUDPSocksAssociation, '::0', 0, $03, LBuf, LPos); //associate request
    end;
    //
    FUDPSocksAssociation.Write(ToBytes(LBuf, LPos)); // send the connection packet
    try
      FUDPSocksAssociation.ReadBytes(LBuf, 2, False);    // Socks server replies on connect, this is the first part )VER and RSP
    except
      raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
    end;

    case LBuf[1] of
      0: ;// success, do nothing
      1: raise EIdSocksServerGeneralError.Create(RSSocksServerGeneralError);
      2: raise EIdSocksServerPermissionError.Create(RSSocksServerPermissionError);
      3: raise EIdSocksServerNetUnreachableError.Create(RSSocksServerNetUnreachableError);
      4: raise EIdSocksServerHostUnreachableError.Create(RSSocksServerHostUnreachableError);
      5: raise EIdSocksServerConnectionRefusedError.Create(RSSocksServerConnectionRefusedError);
      6: raise EIdSocksServerTTLExpiredError.Create(RSSocksServerTTLExpiredError);
      7: raise EIdSocksServerCommandError.Create(RSSocksServerCommandError);
      8: raise EIdSocksServerAddressError.Create(RSSocksServerAddressError);
      else
        raise EIdSocksUnknownError.Create(RSSocksUnknownError);
    end;
    FUDPSocksAssociation.ReadBytes(LBuf, 2, False); //Now get RSVD and ATYPE feilds
    // type of destination address is domain name
    case LBuf[1] of
      // IP V4
      1:  begin
            Lpos := 4 + 2; // 4 is for address and 2 is for port length
            LIPVersion := Id_IPv4;
          end;
      // FQDN
      3: Lpos := LBuf[4] + 2; // 2 is for port length
      // IP V6
      4: begin
           LPos := 16 + 2; // 16 is for address and 2 is for port length
           LIPVersion := Id_IPv6;
         end;
    end;
    try
      // Socks server replies on connect, this is the second part
      FUDPSocksAssociation.ReadBytes(LBuf, Lpos, False); //overwrite the first part for now
      AHandle.SetPeer( (FUDPSocksAssociation as TIdIOHandlerStack).Binding.PeerIP ,LBuf[4]*256+LBuf[5],LIPVersion);
      AHandle.Connect;
    except
      raise EIdSocksServerRespondError.Create(RSSocksServerRespondError);
    end;
  except
    on E: Exception do
    begin
      FUDPSocksAssociation.Close;
      raise;
    end;
  end;
end;

procedure TIdSocksInfo.CloseUDP(AHandle: TIdSocketHandle);
begin
  case Version of
    svSocks4, svSocks4A: raise EIdSocksUDPNotSupportedBySOCKSVersion.Create(RSSocksUDPNotSupported);
    svSocks5: CloseSocks5UDPAssociation;
  end;
end;

procedure TIdSocksInfo.OpenUDP(AHandle: TIdSocketHandle;
  const AHost: string=''; const APort: Integer=0; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);
begin
  case Version of
    svSocks4, svSocks4A: raise EIdSocksUDPNotSupportedBySOCKSVersion.Create(RSSocksUDPNotSupported);
    svSocks5: MakeSocks5UDPAssociation(AHandle);
  end;
end;

function TIdSocksInfo.DisasmUDPReplyPacket(const APacket : TIdBytes;
  var VHost : String; var VPort : Integer): TIdBytes;
{


      +----+------+------+----------+----------+----------+
      |RSV | FRAG | ATYP | DST.ADDR | DST.PORT |   DATA   |
      +----+------+------+----------+----------+----------+
      | 2  |  1   |  1   | Variable |    2     | Variable |
      +----+------+------+----------+----------+----------+
        01    2      3
     The fields in the UDP request header are:

          o  RSV  Reserved X'0000'
          o  FRAG    Current fragment number
          o  ATYP    address type of following addresses:
             o  IP V4 address: X'01'
             o  DOMAINNAME: X'03'
             o  IP V6 address: X'04'
          o  DST.ADDR       desired destination address
          o  DST.PORT       desired destination port
          o  DATA     user data
}
var LLen : Integer;
//  LIP : TIdIPAddress;
  LIP6 : TIdIPv6Address;
  LtempPort : Word;
  LHost : TIdBytes;
  i : Integer;
begin
  if Length(APacket)<5 then
  begin
    Exit;
  end;
    // type of destination address is domain name
    case APacket[3] of
      // IP V4
      1: begin
           LLen := 4 + 4; //4 IPv4 address len, 4- 2 reserved, 1 frag, 1 atype
           VHost := Sys.IntToStr(APacket[4])+'.'+Sys.IntToStr(APacket[5])+'.'+Sys.IntToStr(APacket[6])+'.'+Sys.IntToStr(APacket[7]);

         end;
      // FQDN
      3: begin
           LLen := APacket[4] +4; // 2 is for port length, 4 - 2 reserved, 1 frag, 1 atype
           if Length(APacket)< (5+LLen) then
           begin
             Exit;
           end;
           SetLength(LHost,APacket[4]);
           CopyTIdBytes(APacket,5,LHost,0,APacket[4]);
           VHost := BytesToString(LHost);
         end;
      // IP V6  - 4:
    else
      LLen := 16 + 4; // 16 is for address, 2 is for port length,4 - 2 reserved, 1 frag, 1 atype
      SetLength(LHost,16);
      CopyTIdBytes(APacket,5,LHost,0,16);
      LIP6 := BytesToIPv6(LHost);
      for i := 0 to 7 do
      begin
        LIP6[i] := GStack.NetworkToHost(LIP6[i]);
      end;
      VHost := IPv6AddressToStr(LIP6);
    end;
    LtempPort := APacket[LLen]*256+ APacket[LLen+1];
    VPort := LtempPort;
  LLen := LLen + 2;
  SetLength(Result,Length(APacket)-LLen);
  CopyTIdBytes(APacket,LLen,Result,0,Length(APacket)-LLen);
end;

function TIdSocksInfo.MakeUDPRequestPacket(const AData: TIdBytes;
      const AHost : String; const APort : Integer) : TIdBytes;

{


      +----+------+------+----------+----------+----------+
      |RSV | FRAG | ATYP | DST.ADDR | DST.PORT |   DATA   |
      +----+------+------+----------+----------+----------+
      | 2  |  1   |  1   | Variable |    2     | Variable |
      +----+------+------+----------+----------+----------+
        01    2      3
     The fields in the UDP request header are:

          o  RSV  Reserved X'0000'
          o  FRAG    Current fragment number
          o  ATYP    address type of following addresses:
             o  IP V4 address: X'01'
             o  DOMAINNAME: X'03'
             o  IP V6 address: X'04'
          o  DST.ADDR       desired destination address
          o  DST.PORT       desired destination port
          o  DATA     user data
}
var LLen : Integer;
  LIP : TIdIPAddress;
  LtempPort : Word;
begin
  SetLength(Result,1024);
  Result[0] := 0;
  Result[1] := 0;
  Result[2] := 0; //no fragmentation - too lazy to implement it
  if (length(MakeCanonicalIPv6Address(AHost))>0) then begin
    Result[3] := $4;   // address type: IP V4 address: X'01'    {Do not Localize}
                           //               DOMAINNAME:    X'03'    {Do not Localize}
                           //               IP V6 address: X'04'    {Do not Localize}

    Result[4] :=16; // 16 bytes for the ip
    LLen := 5;
    LIP := TIdIPAddress.MakeAddressObject(AHost);
    try
      if Assigned(LIP) then
      begin
        CopyTIdBytes(LIP.HToNBytes,0,Result,4,16);
      end;
    finally
      Sys.FreeAndNil(LIP);
    end;
    LLen := LLen + 16;
  end
  else
  begin
    // for now we stick with domain name, must ask Chad how to detect
    // address type
    if GStack.IsIP( AHost ) then
    begin
      Result[3] := $01;  //IPv4 address
      Result[4] :=4; // 4 bytes for the ip
      LIP := TIdIPAddress.MakeAddressObject(AHost);
      try
        if Assigned(LIP) then
        begin
          CopyTIdBytes(LIP.HToNBytes,0,Result,4,4);
        end;
      finally
        Sys.FreeAndNil(LIP);
      end;
      LLen := 8;
    end
    else
    begin
      Result[3] := $3;   // address type: IP V4 address: X'01'    {Do not Localize}
                           //               DOMAINNAME:    X'03'    {Do not Localize}
                           //               IP V6 address: X'04'    {Do not Localize}
      // host name
      Result[4] := Length(AHost);
      LLen := 5;
      if Length(AHost) > 0 then begin
        CopyTIdBytes(ToBytes(AHost),0,Result,LLen,Length(AHost));
      end;
      LLen := LLen + Length(AHost);
    end;

  end;

  // port
  LtempPort := APort;  //done this way to avoid a range check error
  LtempPort := GStack.HostToNetwork(LtempPort);
  CopyTIdBytes(ToBytes(LtempPort),0,Result,LLen,2);
  LLen := LLen + 2;
  //now do the rest of the packet
  SetLength(Result,LLen + Length(AData));
  CopyTIdBytes(AData,0,Result,LLen,Length(AData));
end;

function TIdSocksInfo.RecvFromUDP(AHandle: TIdSocketHandle;
 var ABuffer : TIdBytes;
  var VPeerIP: string; var VPeerPort: integer;  const AIPVersion: TIdIPVersion;
  AMSec: Integer = IdTimeoutDefault): integer;
var LBuf : TIdBytes;

begin
  case Version of
    svSocks4, svSocks4A: raise EIdSocksUDPNotSupportedBySOCKSVersion.Create(RSSocksUDPNotSupported);
  end;
  SetLength(LBuf,Length(ABuffer)+200);

  if not AHandle.Readable(AMSec) then begin
    Result := 0;
    VPeerIP := '';    {Do not Localize}
    VPeerPort := 0;
    Exit;
  end;
  Result := AHandle.RecvFrom(LBuf,VPeerIP, VPeerPort);
  SetLength(LBuf,Result);
  LBuf := DisasmUDPReplyPacket(LBuf, VPeerIP, VPeerPort);
  Result := Length(LBuf);
  IdGlobal.CopyTIdBytes(LBuf,0,ABuffer,0,Result);
end;

procedure TIdSocksInfo.SendToUDP(AHandle: TIdSocketHandle;
      AHost: string; const APort: Integer; const AIPVersion: TIdIPVersion; const ABuffer : TIdBytes);
var LBuf : TIdBytes;
begin
  case Version of
    svSocks4, svSocks4A: raise EIdSocksUDPNotSupportedBySOCKSVersion.Create(RSSocksUDPNotSupported);
  end;
  LBuf := MakeUDPRequestPacket(ABuffer, AHost,APort);
  AHandle.Send(LBuf,0);
end;

destructor TIdSocksInfo.Destroy;
begin
 Sys.FreeAndNil(FUDPSocksAssociation);
 inherited Destroy;
end;

end.
